home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 43 / 043.d81 / sliding checkers (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  4KB  |  114 lines
  1. 10 at=679:fori=at to at+22:readx:pokei,x:next:print"[147]":as=3
  2. 20 data32,180,2,132,251,32,180,2
  3. 30 data166,251,76,240,255,32,253,174
  4. 40 goto610
  5. 50 le=len(a$):e=(20+le/2):for a=1 to le:
  6. 55 b$=mid$(a$,le+1-a,1):printb$;
  7. 60 for b=1 to e:print"[157] "b$;
  8. 65 next:print:print"[145]";
  9. 70 e=e-1:next
  10. 80 return
  11. 100 data32,158,173,32,170,177,96
  12. 110 pokevo,15:pokewv,17:pokeak,15:pokehi,58:pokelo,149
  13. 120 fortm=1to100:nexttm:pokewv,0
  14. 130 pokewv,17:pokehi,34:pokelo,75:fortm=1to100:nexttm:pokewv,0:return
  15. 140 rem - setup screen
  16. 150 sys at,1,12:print"sliding checkers[146]";
  17. 160 er=0:fr$="":ct=fre(0)
  18. 170 sys at,9,8:print"[159]1[146]  2[146]  3[146]  4[146]  5[146]  6[146]  7[146]  8[146]  9[146]";
  19. 180 sys at,11,7:printa$(b(1))u$a$(b(2))u$a$(b(3))u$a$(b(4));
  20. 190 sys at,11,19:printa$(b(5))u$a$(b(6))u$a$(b(7))u$a$(b(8))u$a$(b(9))
  21. 200 if f2$="*" then gosub110
  22. 210 sys at,18,15:print"[154]move #";
  23. 220 if as=3 then 815
  24. 230 if d$=e$ then er=3:goto480
  25. 240 if as<>1 then270
  26. 250 zz=zz+1:fr$=mid$(slv$,zz,1):sys at,15,24:printfr$;
  27. 260 for tm=1to750:next:goto330
  28. 270 print:print"[145][145][145]     [154](f1 [154]- auto solve ... f7 [154]- end)"
  29. 275 sys at,15,12:print"[154]enter move:  [157]";:poke198,0
  30. 280 get fr$
  31. 290 for i=1to11:iffr$=mid$("[133][136]123456789",i,1)thenprintfr$;:goto310
  32. 300 next:goto280
  33. 310 if fr$="[133]" then as=1:sys at,3,14:print"auto solving":goto700
  34. 320 if fr$="[136]" then er=5:as=2:goto480:rem - end
  35. 330 fr=val(fr$):if c(fr)=3 thener=1:goto480
  36. 340 for x=1to9:ifmid$(d$,x,1)="3" then tu=x
  37. 350 next
  38. 360 rem - check for legal move
  39. 370 if abs(fr-tu)>2 then er=2:goto480
  40. 380 if abs(fr-tu)=2 then if fr<tu then if c(fr)=c(fr+1) then er=2:goto480
  41. 390 if abs(fr-tu)=2 then if fr>tu then if c(fr)=c(fr-1) then er=2:goto480
  42. 400 if c(fr)=1 then if fr>tu then er=2:goto480
  43. 410 if c(fr)=2 then if fr<tu then er=2:goto480
  44. 420 rem - switch pieces
  45. 430 c=c(tu):c(tu)=c(fr):c(fr)=c
  46. 440 d$="":forx=1to9:d$=d$+right$(str$(c(x)),1):next
  47. 450 forx=1to9:b(x)=c(x):next:f2$="*"
  48. 460 mv=mv+1:mv$="":mv$=str$(mv):sys at,18,22:print mv$;:goto150
  49. 470 rem - msg rtn
  50. 480 if as=1 then er=4
  51. 490 b1=490+(er*10):poke785,188:poke786,168:pokeb1,peek(b1):b1=usr(0)
  52. 500 er$="[150]'from[150]' position empty[146]":goto550
  53. 510 er$="[150]invalid entry[146]":goto550
  54. 520 er$="[154]congratulations!![146]":goto550
  55. 530 er$="[154]puzzle solved![146]":goto550
  56. 540 er$="[154]thanks for playing![146]"
  57. 550 c=(22-len(er$)/2):forx=1to5:sys at,24,c:printer$;:fortm=1to100:nexttm
  58. 560 poke781,24:sys59903:fortm=1to100:nexttm,x
  59. 570 er$="":f2$="":if er<3 then150
  60. 580 if as<>2 then590
  61. 581 run
  62. 590 er=5:as=2:goto490
  63. 600 rem - initialization
  64. 610 dim a$(3),b(9),c(9):poke53280,.
  65. 620 u$="[145][145]"
  66. 630 a$(1)="   [157][157][157] [146][154][209] [157][157][157]   [146]"
  67. 640 a$(2)="   [157][157][157] [146][209] [157][157][157]   [146]"
  68. 650 a$(3)="   [157][157][157] [158]  [157][157][157]   [146]"
  69. 660 e$="222231111":rem - solution format
  70. 670 rem - sound parameters
  71. 680 vo=54296:wv=54276:ak=54277:hi=54273:lo=54272
  72. 690 rem - autosolve mode
  73. 700 d$="111132222":rem - puzzle format
  74. 710 forx=1to9:b(x)=val(mid$(d$,x,1)):c(x)=b(x):next
  75. 720 if as=3 then 1000
  76. 730 mv=0:zz=0:f2$="":sys at,18,22:print"   ";
  77. 740 rem - solution string
  78. 750 slv$="467532468975312468753465"
  79. 760 print"";:goto150
  80. 770 rem - introduction
  81. 780 printchr$(142)"[147]":poke53281,0:sys at,1,12:print"sliding checkers[146]":print
  82. 790 print"  four blue and four white checkers"
  83. 800 print" are arranged as follows:"
  84. 810 as=3:goto150
  85. 815 print:print"          [154]press space[146][154] to continue":poke198,.
  86. 816 ifpeek(203)<>60then816
  87. 820 print"[147]":sys at,1,12:print"sliding checkers[146]":print
  88. 830 print"  [154]reverse the positions of the checkers.":print
  89. 840 print"  blue checkers move only to the":print" right; white checkers to ";
  90. 850 print"the left.":print
  91. 860 print"  you may move to an empty space or"
  92. 870 print" jump over an opposite checker.":print
  93. 880 print"  press f1[154] for auto-solve; f7[154]":print" to end.":print
  94. 890 print"  this puzzle can be solved in 24":print" moves."
  95. 900 sys at,22,8:print"press space[146][154] to continue":poke198,.
  96. 910 get rt$:if rt$<>" " then910
  97. 920 as=0:f2$="":print"[147]":goto1000
  98. 1000 poke53280,.:poke53281,.:printchr$(142)"[147]"
  99. 1005 a$="s l i d i n g   c h e c k e r s":gosub50:print
  100. 1010 print"[158]":a$="by daniel miller":gosub50
  101. 1015 print"          i [154]- instructions"
  102. 1020 print"          p [154]- play sliding checkers"
  103. 1030 print"          q [154]- quit"
  104. 1040 print"          press p [154]or q[154]."
  105. 1050 a=peek(203):ifa<>33anda<>41anda<>62then1050
  106. 1060 ifa=41thenprint"[147]":as=.:goto150
  107. 1070 ifa=33then780
  108. 60000 print"[145]  [154]are you sure you want to quit? (y[154]/n[154])"
  109. 60010 a=peek(203):ifa<>25anda<>39then60010
  110. 60020 ifa=39thenprint"[145]                                      [145]":goto1040
  111. 60030 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  112. 60040 ifer<>63thenend
  113. 60050 load"hello connect",8
  114.